home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue72 / terminal / SystemInfo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-03  |  13.9 KB  |  415 lines
  1. unit SystemInfo;
  2.  
  3. interface
  4.  
  5. Const
  6.   BoolArray : Array[False..True] of String = ('No','Yes');
  7.  
  8. Function GetTerminalServicesInfo : String;
  9. Function GetSystemInfo : String;
  10. Function GetTimeAndDateInfo : String;
  11. Function GetKeyboardLayoutInfo : String;
  12. Function GetAudioDeviceInfo : String;
  13. Function GetMiscInfo : String;
  14. Function GetWinSockInfo : String;
  15. Function GetInternetConnectionInfo : String;
  16.  
  17. implementation
  18.  
  19. Uses
  20.   Windows,Registry,SysUtils,MMSystem,Printers;
  21.  
  22. Const
  23.   { Constants from WINNT.H }
  24.   siaSecurityNTAuthority       : TSIDIdentifierAuthority = (Value: (0,0,0,0,0,5));
  25.   SECURITY_BUILTIN_DOMAIN_RID  = $20;
  26.   DOMAIN_ALIAS_RID_ADMINS      = $220;
  27.   SM_REMOTESESSION             = $1000; { from WinUser.h }
  28.  
  29. Var
  30.   CurrentHostName : String;
  31.  
  32. Function GetTerminalServicesInfo : String;
  33. Var B : Boolean;
  34. Begin
  35.   Result := 'Running under Terminal Services: ';
  36.   If ((Win32Platform = VER_PLATFORM_WIN32_NT) And
  37.       (Win32MajorVersion >= 5)) Then Begin { Windows 2000 or later }
  38.     B := (GetSystemMetrics(SM_REMOTESESSION) <> 0);
  39.     Result := Result+BoolArray[B];
  40.   End
  41.   Else Result := Result+'(cannot determine)';
  42. End;
  43.  
  44. Function RunningAsAdministrator : Boolean;
  45. Var
  46.   hThread         : THandle;
  47.   ptgTokenGroups  : PTokenGroups;
  48.   intTokenGroups  : Cardinal;
  49.   intGroup        : Integer;
  50.   psidAdmin       : PSID;
  51.  
  52. Begin
  53.   Result := False;
  54.   { First we must open a handle to the access token for this thread. }
  55.   If (Not OpenThreadToken(GetCurrentThread,TOKEN_QUERY,False,hThread)) Then Begin
  56.     If (GetLastError = Error_No_Token) Then Begin
  57.       {
  58.       If the thread does not have an access token, we'll examine the
  59.       access token associated with the process.
  60.       }
  61.       If (Not OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,hThread)) Then Exit;
  62.     End
  63.     Else Exit;
  64.   End;
  65.   {
  66.   Then we must query the size of the group information associated with
  67.   the token. Note that we expect a FALSE result from GetTokenInformation
  68.   because we've given it a NULL buffer. On exit cbTokenGroups will tell
  69.   the size of the group information.
  70.   }
  71.   If GetTokenInformation(hThread,TokenGroups,nil,0,intTokenGroups) Then Exit;
  72.   { Here we verify that GetTokenInformation failed for lack of a large enough buffer. }
  73.   If (GetLastError <> Error_Insufficient_Buffer) Then Exit;
  74.   {
  75.   Now we allocate a buffer for the group information. Since _alloca allocates on
  76.   the stack, we don't have to explicitly deallocate it. That happens automatically
  77.   when we exit this function.
  78.   }
  79.   GetMem(ptgTokenGroups,intTokenGroups);
  80.   {
  81.   Now we ask for the group information again. This may fail if an administrator
  82.   has added this account to an additional group between our first call to
  83.   GetTokenInformation and this one.
  84.   }
  85.   If (Not GetTokenInformation(hThread,TokenGroups,ptgTokenGroups,
  86.                               intTokenGroups,intTokenGroups)) Then Exit;
  87.   { Now we must create a System Identifier for the Admin group. }
  88.   If (Not AllocateAndInitializeSid(siaSecurityNTAuthority,2,SECURITY_BUILTIN_DOMAIN_RID,
  89.                                    DOMAIN_ALIAS_RID_ADMINS,0,0,0,0,0,0,psidAdmin)) Then Exit;
  90.   {
  91.   Finally we'll iterate through the list of groups for this access token looking for
  92.   a match against the SID we created above.
  93.   }
  94.   For intGroup := 0 to ptgTokenGroups^.GroupCount-1 do Begin
  95.   {$R-}
  96.     If EqualSid(ptgTokenGroups^.Groups[intGroup].Sid,psidAdmin) Then Begin
  97.   {$R+}
  98.       Result := True;
  99.       Break;
  100.     End;
  101.   End;
  102.   { Before we exit we must explicity deallocate the SID we created. }
  103.   FreeSid(psidAdmin);
  104.   FreeMem(ptgTokenGroups,intTokenGroups);
  105. End;
  106.  
  107. Function GetNTType : String;
  108. Var
  109.   R : TRegistry;
  110.   S : String;
  111.  
  112. Begin
  113.   R := TRegistry.Create;
  114.   R.RootKey := HKEY_LOCAL_MACHINE;
  115.   R.OpenKey('SYSTEM\CurrentControlSet\Control\ProductOptions',False);
  116.   S := UpperCase(R.ReadString('ProductType'));
  117.   R.Free;
  118.   If (S = 'WINNT') Then Result := 'Workstation'
  119.   Else If (S = 'SERVERNT') Then Result := 'Server'
  120.   Else If (S = 'LANMANNT') Then Result := 'Advanced Server'
  121.   Else Result := '(unknown)';
  122. End;
  123.  
  124. Function NetWkstaUserGetInfo(ServerName : PWideChar; Level : Integer;
  125.                              Buf : Pointer) : Integer; StdCall External 'netapi32.dll';
  126.  
  127. Const
  128.   nerr_Success = 0;
  129.  
  130. Type
  131.   PWkstaUserInfo_1 = ^TWkstaUserInfo_1;
  132.   TWkstaUserInfo_1 = Record
  133.     UserName     : PWideChar;
  134.     LogonDomain  : PWideChar;
  135.     OtherDomains : PWideChar;
  136.     LogonServer  : PWideChar;
  137.   End;
  138.  
  139. Function GetNetworkUserLogonInfo(LocalComputerName : String) : String;
  140. Var Buf : TWkstaUserInfo_1;
  141. Begin
  142.   FillChar(Buf,SizeOf(Buf),0);
  143.   Result := '(unknown)';
  144.   If (NetWkstaUserGetInfo(nil,1,@Buf) = nerr_Success) Then Begin
  145.     With Buf do Begin
  146.       Result := 'Logon Domain: ';
  147.       If (LogonDomain = nil) Then Result := Result+LocalComputerName
  148.       Else Result := Result+WideCharToString(LogonDomain);
  149.       Result := Result+#13#10'Logon Server: ';
  150.       If (LogonServer = nil) Then Result := Result+LocalComputerName
  151.       Else Result := Result+WideCharToString(LogonServer);
  152.     End;
  153.   End;
  154. End;
  155.  
  156. Function GetGlobalMemoryStatus : String;
  157. Var MS : TMemoryStatus;
  158. Begin
  159.   MS.dwLength := SizeOf(MS);
  160.   GlobalMemoryStatus(MS);
  161.   With MS do Begin
  162.     Result := 'Total Physical: '+IntToStr(dwTotalPhys div 1024)+' kB'+#13#10+
  163.               'Available Physical: '+IntToStr(dwAvailPhys div 1024)+' kB'+#13#10+
  164.               'Total Page File: '+IntToStr(dwTotalPageFile div 1024)+' kB'+#13#10+
  165.               'Available Page File: '+IntToStr(dwAvailPageFile div 1024)+' kB'+#13#10+
  166.               'Total Virtual: '+IntToStr(dwTotalVirtual div 1024)+' kB'+#13#10+
  167.               'Available Physical: '+IntToStr(dwAvailVirtual div 1024)+' kB';
  168.   End;
  169. End;
  170.  
  171. Function GetEnvironmentVariable(Name : String) : String;
  172. Var I : Integer;
  173. Begin
  174.   Result := '(cannot determine)';
  175.   I := Windows.GetEnvironmentVariable(PChar(Name),nil,0);
  176.   If (I > 0) Then Begin
  177.     SetLength(Result,I-1);
  178.     Windows.GetEnvironmentVariable(PChar(Name),PChar(Result),I);
  179.   End;
  180. end;
  181.  
  182. Function GetSystemInfo : String;
  183. Var
  184.   P  : Array[0..255] of Char;
  185.   I  : Cardinal;
  186.   S  : String;
  187.   SI : TSystemInfo;
  188.   B  : Boolean;
  189.  
  190. Begin
  191.   I := SizeOf(P);
  192.   If (Not GetUserName(P,I)) Then StrPCopy(P,SysErrorMessage(GetLastError));
  193.   Result := 'Current User: '+String(P)+#13#10;
  194.   I := SizeOf(P);
  195.   Result := Result+'Administrator priviledges: '+BoolArray[RunningAsAdministrator]+#13#10;
  196.   If (Not GetComputerName(P,I)) Then StrPCopy(P,SysErrorMessage(GetLastError));
  197.   Result := Result+'Computer Name: '+String(P)+#13#10;
  198.   CurrentHostName := String(P);
  199.   Windows.GetSystemInfo(SI);
  200.   Result := Result+'Processor count: '+IntToStr(SI.dwNumberOfProcessors)+' '+#13#10+
  201.             'Processor level: '+IntToStr(SI.wProcessorLevel)+#13#10;
  202.   If (SI.wProcessorLevel >= 5) Then Begin { only Pentium or above can have MMX instructions }
  203.     Asm
  204.       mov  B,False               { clear flag }
  205.       mov  eax,1                 { request feature flags }
  206.       db   $0F,$A2               { CPUID instruction opcode 0FA2h }
  207.       test edx,$00800000         { Is bit 23 in feature flags set? }
  208.       jz   @@notfound
  209.       mov  B,True                { yes, we have MMX! }
  210.     @@notfound:
  211.     End;
  212.   End;
  213.   Result := Result+'Flawed Pentium division: '+BoolArray[(TestFDIV = -1)]+#13#10;
  214.   Result := Result+'Supports MMX instructions: '+BoolArray[B]+#13#10#13#10;
  215.   Case Win32Platform of
  216.     Ver_Platform_Win32_Windows : S := 'Win95/98';
  217.     Ver_Platform_Win32_NT      : S := 'Windows NT '+GetNTType;
  218.     Else S := 'Other';
  219.   End;
  220.   Result := Result+'OS Version: '+S+' '+IntToStr(Win32MajorVersion)+'.'+
  221.             IntToStr(Win32MinorVersion)+', Build '+
  222.             IntToStr(Win32BuildNumber)+', '+Win32CSDVersion+#13#10;
  223.   S := GetNetworkUserLogonInfo(String(P));
  224.   If (S <> '') Then Result := Result+S+#13#10;
  225.   If (GetSystemDirectory(P,SizeOf(P)) = 0) Then
  226.     StrPCopy(P,SysErrorMessage(GetLastError));
  227.   Result := Result+'System directory: '+String(P)+#13#10;
  228.   If (GetWindowsDirectory(P,SizeOf(P)) = 0) Then
  229.     StrPCopy(P,SysErrorMessage(GetLastError));
  230.   Result := Result+'Windows directory: '+String(P)+#13#10+
  231.             'TEMP environment variable: '+
  232.             GetEnvironmentVariable('TEMP')+#13#10+
  233.             'SYSTEMROOT environment variable: '+
  234.             GetEnvironmentVariable('SYSTEMROOT')+#13#10+
  235.             #13#10+GetGlobalMemoryStatus;
  236.   With Printer do Begin
  237.     Result := Result+#13#10#13#10+'Printers installed:';
  238.     For I := 0 to Printers.Count-1 do
  239.       Result := Result+#13#10+IntToStr(I)+': '+Printers[I];
  240.   End;
  241. End;
  242.  
  243. Function GetTimeAndDateInfo : String;
  244. Const Time_Zone_Id_Daylight = 2; { from MAPIWIN.H }
  245. Var
  246.   TZInfo : TTimeZoneInformation;
  247.   I      : Integer;
  248.   DST    : Boolean;
  249.  
  250. Begin
  251.   Result := 'Current time: '+DateTimeToStr(Now);
  252.   I := GetTimeZoneInformation(TZInfo);
  253.   If (I <> -1) Then Begin
  254.     DST := (I = Time_Zone_Id_Daylight);
  255.     Result := Result+#13#10+'Daylight savings time: '+BoolArray[DST];
  256.     Result := Result+#13#10+'Time zone: ';
  257.     If DST Then Result := Result+WideCharToString(TZInfo.DaylightName)
  258.     Else Result := Result+WideCharToString(TZInfo.StandardName);
  259.     Result := Result+#13#10'Time zone bias: '+IntToStr(-TZInfo.Bias)+' min';
  260.   End;
  261. End;
  262.  
  263. Function GetKeyboardLayoutInfo : String;
  264. Var
  265.   HKLs : Array[1..100] of Integer;
  266.   I,J  : Integer;
  267.  
  268. Begin
  269.   J := GetKeyboardLayoutList(100,HKLs);
  270.   Result := 'Keyboard layouts: '+IntToStr(J)+#13#10;
  271.   For I := 1 to J do Begin
  272.     Result := Result+'Device handle: '+IntToStr(HKLs[I] shr 16)+' '+
  273.               'Language ID: '+IntToStr(HKLs[I] And $FFFF)+#13#10;
  274.   End;
  275.   If GetKeyboardLayoutName(@HKLs) Then { notice re-use of HKLs array }
  276.     Result := Result+'Default layout name: '+PChar(@HKLs);
  277. End;
  278.  
  279. Function GetAudioDeviceInfo : String;
  280. Var
  281.   I,J : Integer;
  282.   IC  : TWaveInCaps;
  283.   OC  : TWaveOutCaps;
  284.  
  285. Begin
  286.   J := WaveInGetNumDevs;
  287.   Result := 'Wave input devices: '+IntToStr(J)+#13#10;
  288.   For I := 1 to J do Begin
  289.     If (WaveInGetDevCaps(I-1,@IC,SizeOf(IC)) = MMSysErr_NoError) Then
  290.       Result := Result+'In #'+IntToStr(I)+': '+String(IC.szPname)+#13#10;
  291.   End;
  292.   J := WaveOutGetNumDevs;
  293.   Result := Result+'Wave output devices: '+IntToStr(J)+#13#10;
  294.   For I := 1 to J do Begin
  295.     If (WaveOutGetDevCaps(I-1,@OC,SizeOf(OC)) = MMSysErr_NoError) Then
  296.       Result := Result+'Out #'+IntToStr(I)+': '+String(OC.szPname)+#13#10;
  297.   End;
  298.   SetLength(Result,Length(Result)-2); { delete last CRLF }
  299. End;
  300.  
  301. Function GetMiscInfo : String;
  302. Var B : Bool;
  303. Begin
  304.   SystemParametersInfo(spi_GetDragFullWindows,0,@B,0);
  305.   Result := 'Drag full windows: '+BoolArray[B]+#13#10;
  306.   SystemParametersInfo(spi_GetScreenSaveActive,0,@B,0);
  307.   Result := Result+'Screen saver set: '+BoolArray[B];
  308. End;
  309.  
  310. Type
  311.   PWSAData = ^TWSAData;
  312.   TWSAData = Packed Record
  313.     Version      : Word;
  314.     HighVersion  : Word;
  315.     Description  : Array[0..256] of Char;
  316.     SystemStatus : Array[0..128] of Char;
  317.     { record continues but we don't care... }
  318.   End;
  319.  
  320.   TWSAStartup = Function(Version : Word; Data : Pointer) : Integer; StdCall;
  321.   TWSACleanup = Function : Integer; StdCall;
  322.  
  323.   PHostEnt = ^THostEnt;
  324.   THostEnt = Packed Record
  325.     Name: PChar;
  326.     Aliases: ^PChar;
  327.     AddrType: Smallint;
  328.     Length: Smallint;
  329.     Case Byte of
  330.       0 : (AddrList : ^PChar);
  331.       1 : (Addr : ^PChar);
  332.   End;
  333.  
  334.   TGetHostByName = Function(Name : PChar) : PHostEnt; StdCall;
  335.  
  336. Function GetWinSockInfo : String;
  337. Var
  338.   WSLib       : THandle;
  339.   StartFunc   : TWSAStartup;
  340.   CleanFunc   : TWSACleanup;
  341.   GetNameFunc : TGetHostByName;
  342.   Buf         : Array[0..400] of Char;
  343.   P           : PHostEnt;
  344.  
  345. Begin
  346.   Result := '';
  347.   WSLib := LoadLibrary('wsock32.dll');
  348.   If (WSLib = 0) Then Begin
  349.     Result := 'Cannot load "wsock32.dll": '+SysErrorMessage(GetLastError);
  350.     Exit;
  351.   End;
  352.   StartFunc := GetProcAddress(WSLib,'WSAStartup');
  353.   CleanFunc := GetProcAddress(WSLib,'WSACleanup');
  354.   GetNameFunc := GetProcAddress(WSLib,'gethostbyname');
  355.   StartFunc($0101,@Buf);
  356.   With PWSAData(@Buf)^ do Begin
  357.     Result := 'Version: '+IntToStr(LoByte(HighVersion))+'.'+IntToStr(HiByte(HighVersion))+#13#10+
  358.               'Description: '+String(Description)+#13#10+
  359.               'System status: '+String(SystemStatus);
  360.   End;
  361.   P := GetNameFunc(PChar(CurrentHostName)); { CHN is initialized by GetSystemInfo }
  362.   If (P <> nil) Then Begin
  363.     With P^ do Begin
  364.       Move(Addr^^,Buf,4); { double pointer dereference }
  365.       Result := Result+#13#10+'Host name: '+Name+#13#10+
  366.                 'IP address: '+IntToStr(Ord(Buf[0]))+'.'+IntToStr(Ord(Buf[1]))+'.'+
  367.                 IntToStr(Ord(Buf[2]))+'.'+IntToStr(Ord(Buf[3]));
  368.     End;
  369.   End;
  370.   CleanFunc;
  371.   FreeLibrary(WSLib);
  372. End;
  373.  
  374. Type
  375.   TGetConnectedState = Function(Var Flags : Integer; Reserved : Integer) : Bool; StdCall;
  376.  
  377. Const
  378.   Internet_Connection_Modem = 1;
  379.   Internet_Connection_LAN   = 2;
  380.   Internet_Connection_Proxy = 4;
  381.  
  382. Function GetInternetConnectionInfo : String;
  383. Var
  384.   WILib : THandle;
  385.   GetCS : TGetConnectedState;
  386.   State : Integer;
  387.  
  388. Begin
  389.   WILib := LoadLibrary('wininet.dll');
  390.   If (WILib = 0) Then Begin
  391.     Result := 'Cannot load "wininet.dll": '+SysErrorMessage(GetLastError);
  392.     Exit;
  393.   End;
  394.   GetCS := GetProcAddress(WILib,'InternetGetConnectedState');
  395.   If (@GetCS <> nil) Then Begin
  396.     Result := 'Connected to Internet: ';
  397.     If GetCS(State,0) Then Begin
  398.       Result := Result+'Yes, with ';
  399.       If ((State And Internet_Connection_Modem) <> 0) Then
  400.         Result := Result+'modem, ';
  401.       If ((State And Internet_Connection_LAN) <> 0) Then
  402.         Result := Result+'LAN, ';
  403.       If ((State And Internet_Connection_Proxy) <> 0) Then
  404.         Result := Result+'proxy, ';
  405.       SetLength(Result,Length(Result)-2); { remove comma & space }
  406.     End
  407.     Else Result := Result+'No';
  408.   End
  409.   Else Result := 'Cannot find function "InternetGetConnectedState" from WinInet:'+
  410.                  SysErrorMessage(GetLastError);
  411.   FreeLibrary(WILib);
  412. End;
  413.  
  414. end.
  415.